perm filename MIXAL[MIX,SYS]1 blob
sn#197119 filedate 1976-01-17 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00032 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00005 00002 SUBTTL FINFO - FILE INFORMATION
C00012 00003 BEGIN MIXAL ↔ SUBTTL MIXAL - MIX ASSEMBLER SUBROUTINE
C00014 00004 The syntax of this version of MIXAL is as follows:
C00017 00005 MIXAL produces two output files:
C00019 00006 VALUE ← 0 this will hold the numeric value of the evaluated EXPR
C00022 00007 COMMENT STATAB is a macro which is used to create the state-tables
C00023 00008 COMMENT this page contains all the i/o stuff for creating the
C00026 00009 COMMENT If the value of the word to be displayed is
C00029 00010 subroutine to output a string of ASCII characters to the .LST file
C00037 00011 COMMENT this page has all the i/o stuff for making the
C00040 00012 COMMENT ZERROR is the error-message macro.
C00043 00013 COMMENT HASH is a macro which gets a pointer to an address in
C00046 00014 COMMENT INCHAR -- a subroutine which reads the next character
C00050 00015 COMMENT SCAN is a subroutine which does all the input work
C00058 00016 COMMENT LOCALN and XLOCAL give the necessary data for dealing
C00059 00017 COMMENT there are several places where a special scan is required.
C00063 00018 COMMENT GETSEQ -- a subroutine which gets the next sequence
C00066 00019 COMMENT CHRTAB is the table which indicates what various
C00069 00020 SIXMIX: =00 <space>
C00071 00021 OPDEF SCAN [PUSHJ P, SCAN00]
C00072 00022 COMMENT EXPR -- this is a subroutine to find the longest
C00076 00023 COMMENT WVAL -- a subroutine to find the longest possible
C00081 00024 COMMENT VALIDF is a table of byte pointers into MIXWRD.
C00083 00025 COMMENT MAIN is the section which starts off each line.
C00088 00026 COMMENT note that OPCODE (MAIN) is also done by pretending
C00093 00027 ↑EQU: WVAL get W-value
C00097 00028 SYMAD ←← 15
C00104 00029 ↑mixal: movei p, acsave
C00108 00030 OPLIST: SIXBIT /ADD/
C00113 00031 GOTOP: 0501 ADD
C00117 00032 IFN MIXASM,< finish up the FAIL assembly if making MIXAL
C00118 ENDMK
C⊗;
SUBTTL FINFO - FILE INFORMATION
;Assembly switch MIXASM, if non zero will make this the last file assembled.
;Suitable for making a copy of MIXAL.
COMMENT ⊗ This subroutine is used to get file information
from the user. All blanks are suppressed. Syntax
is as follows:
<filename>.<extension>[proj,prog]
with <extension> and [ppn] optional
Called by "PUSHJ P,FINFO"
⊗
FINFI2: SETZM BLK ;*RES* ENTER TO PICK UP NAME
SETZM BLK+1 ;*RES* RESCANNED BY RESCN
SETZM BLK+2
SETZM BLK+3
MOVE 11, [POINT 6, BLK] ; INIT POINTER FOR FILENAME
MOVEI 12, 6 ; SET UP COUNTER IN 12
MOVE 10,RECHAR ;*RES* GET RESCANNED CHARACTER
JRST FINFI3 ;*RES* WE ALREADY KNOW NON-BLANK
FINFO: SETZM BLK ; INITIALIZE BLK
SETZM BLK+1
SETZM BLK+2
SETZM BLK+3
MOVE 11, [POINT 6, BLK] ; INIT POINTER FOR FILENAME
MOVEI 12, 6 ; SET UP COUNTER IN 12
INCHWL 10 ; READ FIRST CHAR OF LINE
SKIPA
FINFLP: INCHRW 10 ; NEXT CHAR
CAIN 10, 40 ; <BLANK> → KEEP READING
JRST .-2
CAIN 10, 15 ; C-R → ALL DONE
JRST FINDON
FINFI3: CAIN 10, "[" ; "[" → PPN COMES NEXT
JRST PPN
CAIE 10, "." ; "." → EXTENSION COMES NEXT
JRST .+4
MOVE 11, [POINT 6, BLK+1] ; FIX POINTER FOR EXTENSION
MOVEI 12, 3 ; SET COUNTER TO 3
JRST FINFLP
TRZN 10, 100 ;*RES* CONVERT TO SIXBIT BY
TRZA 10, 40 ; REPLACING BIT 30 BY BIT 29
TRO 10, 40
SOJL 12, FINFLP ; N ← N-1
IDPB 10, 11 ; N≥0 → PUT INTO BLK
JRST FINFLP ; BACK FOR MORE CHARS
PPN: SETZ 13, ; 13 IS A SWITCH FOR PROJ OR PROG
MOVEI 12, 3 ; SET UP COUNTER
SETZ 11, ; 11 WILL CONTAIN 3 SIXBIT CHARS
PPNLP: INCHRW 10 ; READ CHAR
CAIN 10, 40 ; <BLANK> → KEEP READING
JRST .-2
CAIN 10, 15 ; C-R → ALL DONE
JRST PLPDON
CAIN 10, "," ; "," → PROJ DONE
JRST PLPDON
CAIN 10,"]" ;*RES* "]" → PROG DONE
JRST PLPDON ;*RES*
TRZN 10, 100 ;*RES* CONVERT TO SIXBIT
TRZA 10, 40
TRO 10, 40
SOJL 12, PPNLP ; N←N-1; <0 → NO MORE INTO 11
LSH 11, 6 ; SHIFT 11 AND
ADD 11, 10 ; ADD ON CHAR FROM 10
JRST PPNLP ; BACK FOR MORE
PLPDON: JUMPG 13, .+4 ; 13>0 → PROGRAMMER NAME
HRLZM 11,BLK+3 ;*RES* PUT PROJ INTO LEFT HALF
MOVEI 13, 1 ; SO GET PROG NEXT
JRST PPN+1
HRRM 11,BLK+3 ;*RES* PUT PROG INTO RIGHT HALF
FINDON: INCHRW 10 ; READON UNTIL LINE-FEED
CAIE 10, 12
JRST .-2
POPJ P,
BLK: 0 ; WILL CONTAIN FILENAME
0 ; WILL CONTAIN EXTENSION
0
0 ; WILL CONTAIN PROJ,PROG
BEGIN MIXAL ↔ SUBTTL MIXAL - MIX ASSEMBLER SUBROUTINE
COMMENT ⊗
M I X A L
MIXAL is the symbolic assembler for use with the MIX 1009
computer. This version is a semi-free-format version (free format but
only one statement per line) which is almost compatible with the
version described in Knuth (the few exceptions are described below).
To use MIXAL, simply type: RUN DSK MIXAL[MIX,DRB]
MIXAL will ask for a filename, which must be a legal filename
without an extension. All you need to do is type the name followed
by a carriage-return. MIXAL will do all the rest. When "*****" is
typed, it means that the entire program has been assembled. MIXAL
will then do a few bookkeeping tasks and exit.
The syntax of this version of MIXAL is as follows:
<program> ::= <statement> <c-r,l-f> <program>
END <W-value> <c-r,l-f>
<statement> ::= <location> <op-add> [; remarks]
<comment-line>
<empty>
<comment-line> ::= * <anything else may come here>
<location> ::= <symbol>
<empty>
<op-add> ::= <operator> <address>
<pseudo-op-add>
<empty>
<operator> ::= <any of the symbolic MIX operators>
<address> ::= <A-part> <index-part> <F-part>
<pseudo-op-add> ::= EQU <W-value>
ORIG <W-value>
CON <W-value>
ALF <any character including space> <any 5 characters>
<W-value> ::= <expression> <F-part>
<expression> <F-part> , <W-value>
<A-part> ::= <expression>
<future-reference>
<empty>
<index-part> ::= ,<expression>
<empty>
<F-part> ::= ( <expression> )
<empty>
<expression> ::= <atomic-expression>
+ <atomic-expression>
- <atomic-expression>
<expression> <binary-operator> <atomic-expression>
<binary-operator> ::= + - * / // :
<atomic-expression> ::= <number>
<symbol(defined)>
*
<number> ::= <string of digits>
<symbol> ::= <string of letters and digits (at least one letter)>
<future-reference> ::= <symbol(undefined)>
= <W-value> =
The same conventions with regard to local symbols (dH, dB, dF), as
described in Knuth, hold here.
The only incompatibilities with Knuth's version are:
1) remarks on non-comment lines must be preceded by a ";"
2) in an ALF statement, there must be exactly one character
(which may be <tab>) between ALF and the five characters
which are the constant.
If the LOC field is supposed to be empty, there must be either a
<space> or a <tab> as the first character in the line.
Also note that SOS line-numbers and page-marks are ignored.
MIXAL produces two output files:
1) a .LST file which is a program listing
2) a .MLD file which may be read into the MIX computer
by the MLD (MIX-LOAD) button.
The format of the .MLD file is:
1) a sequence of boxes, each 20(octal) words long,
in the following form:
word 0: XWD A, N
words 1-N: MIX words to be loaded into A, A+1, ..., A+N-1
2) a sequence of chain words of the following form:
bit 0=1
bits 6-17=A
bits 18-35=B
B is to be loaded into the chained locations beginning
at A. (The address already at A gives the next chain
location, or -1 if the chain is over.)
3) a starting-address block of the form:
word 0: 0
word 1: starting address (relative to the address 0000 in MIX)
4) 3400(octal) words giving the symbol table.
⊗
VALUE ← 0 ; this will hold the numeric value of the evaluated EXPR
CHARX ← 1 ; this is used for miscellaneous stuff
CHAR ← 2 ; this will hold the char to begin the next SCAN
SYMLNK ← 4 ; to save link to symbol table with future-references
SAVER ← 6 ; this will hold VALUE while evaluating FPART
SCNVAL ← 5 ; this will hold the value associated with the returned token in SCAN
FPART ← 7 ; this will hold the evaluated F-part
MIXWRD ← 10 ; this will hold the assembled MIX word
SCANT ← 11 ; this will hold the most recent scan token
SCANTT ← 12 ; this will hold the next most recent scan token
STATE ← 13 ; this will hold the state number of the MAIN, WVAL fsa's
XSTATE ← 14 ; this will hold the state number of the EXPR fsa
BINOP ← 15 ; this will hold the token number of the operator
ORIGIN ← 16 ; this will hold the value of *
; P ← 17 ; this is for the push-down list
TOKENS ←← =15 ; at present there are 15 tokens which the scanner may return
LINE ←← 00 ; for end of line
COMMA ←← 01 ; ,
LPAREN ←← 02 ; (
RPAREN ←← 03 ; )
NUMBER ←← 04 ; for a number
SYMBOL ←← 05 ; for a defined symbol
UPAR ←← 06 ; for a future reference [or ↑]
LOC ←← 07 ; for an empty LOC field
PLUS ←← 10 ; +
MINUS ←← 11 ; -
STAR ←← 12 ; *
SLASH ←← 13 ; /
LEFTAR ←← 14 ; // [or ←]
COLON ←← 15 ; :
EQUALS ←← 16 ; = [should only occur after a WVAL in a literal]
COMMENT ⊗ STATAB is a macro which is used to create the state-tables
for the various fsa's.
it is called by STATAB (α,α,α,α, α,α,α,α, α,α,α,α, α,α,α)
where the α's are the next state to enter.
⊗
DEFINE STATAB (A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15)
{FOR X IN (A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15)
{X
}
}
COMMENT ⊗ this page contains all the i/o stuff for creating the
.LST file
⊗
OBUF: BLOCK 3 ; output buffer
ONAME: SIXBIT / / ; for ENTER UUO
SIXBIT /LST/
0
0
ttle: block 20
ttl1: block 5 ; date and time go here.
TITLE0: ASCIZ / MIXAL(Jan 16) /
title1: asciz /Page /
block 2
TITLE2: ASCIZ /
/ ;______ (two lines above, these are blanks)
↑MONTH: ASCII/-Jan--Feb--Mar--Apr--May--Jun--Jul--Aug--Sep--Oct--Nov--Dec-/
OUTLIN: BLOCK 30 ; will hold the line to be printed on .LST
OUTL0: ASCII / / ; 29 blanks and a <tab>
ASCII / /
ASCII / /
ASCII / /
ASCII / /
ASCII / /
ERRLIN: REPEAT 20 {ASCII / /} ; will hold arrows for errors
ASCIZ /
/
ERRLN0: ASCII / errors: /
REPEAT 15 {ASCII / /}
OUTN: 0 ; will hold the number of characters left in the line
OUTP: 0 ; will contain a pointer to the characters in the line
OUTP0: POINT 7, OUTLIN+6 ; to initialize pointer
ARROW1: POINT 7, OUTLIN+1, 20 ; for indicator arrows
ARROW2: POINT 7, OUTLIN+1, 6
COMMENT ⊗ If the value of the word to be displayed is
in MIXWRD then the following tables can be used to
get the appropriate byte groups for updating the
display.
n = a 4-bit number, where bit k is on if
byte k in the MIX word should begin
a new grouping. (e.g. standard
instruction format is:
n=7 or + AA I F C)
i = the # of the group which you wish to use (1≤i≤5)
BYTPTR+5*n+i-1 is a byte pointer to the right bytes
or 0 if no bytes left
BYTDIv+5*n+i-1 contains the divisor to start finding
the digits with
⊗
ULIST1
BYTPTR: FOR I←0,17
{ULIST2
X1←←X2←←X3←←X4←←X5←←6
Y1←←=11
Y2←←=17
Y3←←=23
Y4←←=29
Y5←←=35
Z←←1
FOR @$ J←3,0,-1
{IFE I∧1⊗J,
{FOR @! K←Z,Z
{X!K←←X!K+6
Y!K←←Y!K+6
}
FOR @! K←Z+1,4
{FOR @% K1←K+1,K+1
{X!K←←X%K1
Y!K←←Y%K1
}
}
}
IFN I∧1⊗J, {Z←←Z+1}
}
FOR @$ J←1,Z
{ POINT X$J, MIXWRD, Y$J
}
FOR J←Z+1,5
{ 0
}
}
LIST
ULIST1
BYTDIV: FOR I←0,17
{ULIST2
X1←←X2←←X3←←X4←←X5←←6
Z←←1
FOR @$ J←3,0,-1
{IFE I∧1⊗J,
{FOR @! K←Z,Z
{X!K←←X!K+6
}
FOR @! K←Z+1,4
{FOR @% K1←K+1,K+1
{X!K←←X%K1
}
}
}
IFN I∧1⊗J, {Z←←Z+1}
}
FOR @$ J←1,5
{D←←1
FOR K←1,X$J/3-1
{D←←=10*D
}
D
}
}
LIST
BYTEN: 0 ; this will hold the byte descriptor
; subroutine to output a string of ASCII characters to the .LST file
; call by: PUTSTR <starting address of ASCIZ string>
; accumulator 1 is used
DEFINE PUTSTR (X)
{ PUSH P, [POINT 7, X]
PUSHJ P, PTSTR0
}
PTSTR0: ILDB 1, -1(P) ; get character from string
JUMPN 1, .+3 ; 0 → string is over
POP P, -1(P) ; get rid of argument
POPJ P, ; return
PUSHJ P, PUTCHR ; put character on .LST file
JRST PTSTR0 ; back for more
; subroutine to do the actual data transfers
; call by: PUSHJ P, PUTCHR
; character is assumed to be in accumulator 1
; accumulator 1 is used
PUTCHR: sosg obuf+2
OUT 2, ; count exhausted, next buffer
JRST .+2 ; success
JRST OUTERR
IDPB 1, OBUF+1 ;***** send character to .LST file
cain 1,12
sosle lincnt
cpopj: POPJ P, ; return
hdr: push p,15
push p,10
push p,11
move 15,[point 7,title1+1]
move 10,pagen
aoj 10,
skipn stflg ; if doing symbol table,
pushj p,putd
movei 1,"S"
skipe stflg
idpb 1,15 ; use neat "S" a la MACRO
movei 1,"-"
idpb 1,15
aos 10,pagex
pushj p,putd
movei 10,=54
movem 10,lincnt
putstr ttle ; program name or stuff from TITLE pseudoop
putstr ttl1 ; date and time
putstr title0 ; mixal i.d.
putstr title1 ; Page xx-xx
putstr title2 ; crlflf or some such thing.
pop p,11
pop p,10
pop p,15
setom first
popj p,
pagex: 0 ; holds how many pages this "page" really is.
lincnt: 0 ; holds count of unused lines on this page
; subroutine to put ORIGIN into the right place in OUTLIN
; call by: PUTLOC
; accumulators 0, 1, 3 are used
OPDEF PUTLOC [PUSHJ P, .]
MOVE 3, [POINT 7, OUTLIN] ; LOC will go at beginning of line
MOVE 0, ORIGIN ; get LOC
PTLC0: CAIL 0, 0 ; is it between 0 and 3999?
CAILE 0, =3999
JRST [MOVEI 0, "*" ; invalid address
IDPB 0, 3 ; so put **** there instead
IDPB 0, 3
IDPB 0, 3
IDPB 0, 3
POPJ P, ]
IDIVI 0, =1000 ; get first digit
ADDI 0, 60
IDPB 0, 3
MOVE 0, 1
IDIVI 0, =100 ; get second digit
ADDI 0, 60
IDPB 0, 3
MOVE 0, 1
IDIVI 0, =10 ; get third and fourth digits
ADDI 0, 60
IDPB 0, 3
ADDI 1, 60
IDPB 1, 3
POPJ P, ; now return
; subroutine to put MIXWRD into the right place in OUTLIN
; call by: PUTMIX
; accumulators 0, 1, 3, 4 are used
OPDEF PUTMIX [PUSHJ P, .]
MOVE 3, [POINT 7, OUTLIN+1, 27]; MIXWRD will go here
MOVE 1, BYTEN ; 1 holds byte descriptor
IMULI 1, 5 ; n*5
MOVEI 0, "+" ; assume it is positive
JUMPGE MIXWRD, .+2 ; right
MOVEI 0, "-" ; whoops, wrong assumption
IDPB 0, 3 ; put sign into OUTLIN
MOVNI 0, 4 ; 0 holds i-4
NXTGRP: IBP 3 ; <for space>
MOVE 4, 1 ; 4 ← 5*n+i-4
ADD 4, 0
SKIPN BYTPTR+4(4) ; test pointer
POPJ P, ; 0 → all done
LDB 7, BYTPTR+4(4) ; get value of byte
MOVE 5, BYTDIV+4(4) ; get initial divisor
MOVE 6, 7 ; get dividend
IDIV 6, 5 ; get first digit
ADDI 6, 60 ; convert to ASCII
IDPB 6, 3 ; put into OUTLIN
IDIVI 5, =10 ; get next divisor
JUMPG 5, .-5 ; back for more digits
AOJLE 0, NXTGRP ; more groups if ≤0
POPJ P, ; return
; subroutine to put decimal form of MIXWRD into right place on OUTLIN
; call by: PUTDEC
; accumulators 0, 1, 3 are used
; note: this clever bit of programming is copied out of the DEC manual, p. 2-65
OPDEF PUTDEC [PUSHJ P, .]
MOVE 3, [POINT 7, OUTLIN+1, 27]; it will go here
MOVE 0, MIXWRD ; 0, 1 are work registers
PTDC0: MOVEI 1, "+" ; first we do the sign
JUMPGE 0, .+3 ; positive
MOVEI 1, "-" ; negative
MOVNS 0, 0
IDPB 1, 3 ; put into OUTLIN
NXTDIG: IDIVI 0, =10 ; get next digit
ADDI 1, 60 ; convert to ASCII
HRLM 1, (P) ; save digit on push-down-list
SKIPE 0 ; 0 → no more digits to get
PUSHJ P, NXTDIG ; get next
HLRZ 1, (P) ; get digits back in correct order
IDPB 1, 3 ; put into OUTLIN
POPJ P, ; all done with this char
; subroutine to output a decimal number to the TTY (which, incidently,
; is not the same thing as the .LST file)
; call by: OUTDEC <address of number to be outputed>
; accumulators 3, 4 are used
; note how similar this clever programming is to the previous example
DEFINE OUTDEC (X)
{ MOVE 3, X
PUSHJ P, OUTDC0
}
OUTDC0: IDIVI 3, =10 ; get next digit
ADDI 4, 60 ; convert to ASCII
HRLM 4, (P) ; save digit on push-down-list
SKIPE 3 ; 0 → no more digits to get
PUSHJ P, OUTDC0 ; get next
HLRZ 4, (P) ; get digits back in correct order
OUTCHR 4 ; send to TTY
POPJ P, ; done with this digit
COMMENT ⊗ this page has all the i/o stuff for making the
.MLD file
⊗
OBUF2: BLOCK 3 ; output buffer
ONAME2: SIXBIT / / ; for use with ENTER
SIXBIT /MLD/
0
0
BOX: BLOCK 20 ; will hold boxes to output to .MLD file
; subroutine to output all of BOX to the .MLD file
; call by: OUTBOX
; accumulators 3, 4 are used
OPDEF OUTBOX [PUSHJ P, .]
MOVNI 3, 20 ; will send entire buffer
MOVE 4, BOX+20(3) ; get word
PUSHJ P, PUTWRD ; output it
AOJL 3, .-2 ; back for more
POPJ P, ; return
PUTWRD: SOSG OBUF2+2 ; decrement counter
OUT 3, ; count exhausted, next buffer
JRST .+2 ; success
JRST OUTERR
IDPB 4, OBUF2+1 ; send char to .MLD file
POPJ P, ; return
; subroutine to take assembled words and send to .MLD file (also to .LST file)
; call by: BUILD
; accumulators 3, 4, 5, [0, 1 in PUTLOC, PUTMIX] are used
OPDEF BUILD [PUSHJ P, .]
JUMPE SCANT, .+3 ; go to end-of-line
PUSHJ P, SCAN00
JRST .-2
BUILD1: PUTLOC ; put ORIGIN into OUTLIN
PUTMIX ; MIXWRD, too
SKIPN 3, BOX ; get head of box
JRST NEWBOX ; 0 → it's a new box
HRRZ 4, 3 ; get count
CAIL 4, 17 ; is box filled?
JRST OUTNEW ; yes
HLRZ 5, 3 ; check if ORIGIN is right
ADD 5, 4
CAME ORIGIN, 5 ; ORIGIN = BOXl + BOXr ?
JRST OUTNEW ; no → get a new box
AOS BOX ; increase count
AOJ 4,
MOVEM MIXWRD, BOX(4) ; add to box
POPJ P, ; return
OUTNEW: OUTBOX ; output this box
NEWBOX: HRLZM ORIGIN, BOX ; init box header
AOS BOX ; increase count
MOVEM MIXWRD, BOX+1 ; deposit first word
POPJ P, ; return
COMMENT ⊗ ZERROR is the error-message macro.
it is called by: ZERROR <[ASCIZ /error message/]>,i
⊗
DEFINE ZERROR (X,Y,Z)
{ PUSHJ P, ERROR0
MOVEI 3, Y
MOVE 4, [POINT 7, Z]
PUSHJ P, ERROR1
OUTSTR X
PUSHJ P, ERROR2
}
ERROR0: MOVE 3, [1000001]
ADDM 3, ERRORQ
POPJ P,
ERROR1: ILDB 3, 4
JUMPE 3, .+3
IDPB 3, ERRORP
JRST .-3
OUTSTR [ASCIZ /
→→→→ PAGE /]
MOVE 3,PAGEN
AOJ 3,
PUSHJ P,OUTDC0
OUTSTR [ASCIZ /, LINE /]
OUTSTR LINEN
POPJ P,
ERROR2: OUTSTR [ASCIZ /
/]
MOVE 4, OUTP ; need c-r, l-f after line
MOVEI 3, 15
IDPB 3, 4
MOVEI 3, 12
IDPB 3, 4
SETZ 3,
IDPB 3, 4
OUTSTR OUTLIN
OUTSTR [ASCIZ /
/]
POPJ P,
ERRORQ: 0 ; left half = total errors ; right half = errors this line
ERRORL: REPEAT 20 {0} ; error indicators
ERRORP: POINT 7, ERRLIN+3
OPDEF ERROUT [PUSHJ P, .]
HRRZ 3, ERRORQ
SKIPN 3
JRST EOUT1
PUTSTR ERRLIN
EOUT1: HLLZS ERRORQ
MOVE 3, [POINT 7, ERRLIN+3]
MOVEM 3, ERRORP
MOVE 3, [XWD ERRLN0, ERRLIN]
BLT 3, ERRLIN+17
POPJ P,
OUTERR: ZERROR <[ASCIZ /ERROR ON OUTPUT/]>,1,<[ASCIZ /1 /]>
CALL [SIXBIT /EXIT/]
BADOP: ZERROR <[ASCIZ /ILLEGAL OPERATOR/]>,2,<[ASCIZ /2 /]>
SETZ MIXWRD,
JRST OPCODE
SYNERR: ZERROR <[ASCIZ /SYNTAX ERROR/]>,3,<[ASCIZ /3 /]>
JRST BADLIN
BADLIN: JUMPE SCANT, MAIN
PUSHJ P, SCAN00
JRST .-2
COMMENT ⊗ HASH is a macro which gets a pointer to an address in
SYMTB, which in turn points to the beginning of the
bucket list for that bucket in the symbol table. the
pointer is zero if that bucket hasn't been used yet.
called by: HASH
accumulators SCNVAL, 4 are used.
the pointer is returned in SCNVAL.
⊗
DEFINE HASH
{ LDB SCNVAL, [POINT 8, SEQNAM, 7] ; take the first 8 bits of SEQNAM
LDB 4, [POINT 8, SEQNAM, 15] ; and the next 8 bits,
XOR SCNVAL, 4 ; XOR them together
ADDI SCNVAL, SYMTB ; and get the pointer
}
LINK: XWD 400000, LINKD-4 ; points to the most recently used space in LINKD
ULIST1
SYMTB: REPEAT 400 {0
ULIST2}
LIST
LINKD: BLOCK 600*4
SYMLEN ← .-SYMTB
; subroutine to add an entry to the symbol table.
; chars in name of entry are in ENTRY, ENTRY+1
; address of place to put pointer is in ENTLNK
; accumulators 3, 4 are used.
; call by: ADDSYM
OPDEF ADDSYM [PUSHJ P, .]
MOVEI SYMLNK, 4 ; create pointer to new entry
ADDB SYMLNK, LINK ; this is it
HRRM SYMLNK, @ENTLNK ; put pointer where we want it
HLLZM SYMLNK, (SYMLNK) ; initialize first word of entry
MOVE 3, ENTRY ; get print name
MOVEM 3, (SYMLNK) 1
MOVE 3, ENTRY+1
MOVEM 3, (SYMLNK) 2
POPJ P, ; and return
ENTLNK: 0 ; 0 if defined, >0 if address of place to put pointer
ENTRY: 0
0
SAVENT: BLOCK 3
COMMENT ⊗ INCHAR -- a subroutine which reads the next character
from the input file, changes <tab> to <space> and
converts to SIXBIT. a <carriage-return><line-feed> is
returned as octal 100.
called by: INCHAR
accumulator CHARX is used.
the character is returned in CHARX.
⊗
realch: 0
inchr9: pushj p,inchr1
caie charx,15
jrst .-2
pop p,3
idpb charx,outp
INCHAR: PUSHJ P,INCHR1
movem charx,realch
JUMPE CHARX, INCHAR ; <null> → ignore it
CAIN CHARX, 15 ; <C-R> → go back for <L-F>
jrst inchar-1
CAIN CHARX, 12 ; <L-F> → 100
JRST CR
CAIN CHARX,14 ; Page mark ?
JRST [AOS PAGEN ; yes, count up pages.
setzm pagex
push p,1
movei 1,14
pushj p,putchr
pushj p,hdr
pop p,1
JRST INCHAR]
PUSH P,3
aos 3,outn
cail 3,=118
jrst inchr9 ; too many chars so eat rest of line
idpb charx,outp
CAIN CHARX, 11 ; <tab> → <space>
JRST [ SOS 3,OUTN
ANDI 3,770
ADDI 3,10
MOVEM 3,OUTN
MOVEI CHARX," "
JRST .+1]
POP P,3
TRZE CHARX, 100 ; convert to SIXBIT
TROA CHARX, 40
TRZ CHARX, 40
POPJ P, ; return
CR: idpb charx,outp ; use <null> for last char in OUTLIN
movei charx,
IDPB CHARX, OUTP
MOVEI CHARX, 100
POPJ P,
PAGEN: 0 ; will hold page-number
INCHR1: SOSG IBUF+2
IN 1,
JRST INCH10
ZERROR <[ASCIZ/Input error or premature EOF/]>,4,<[ASCIZ/4 /]>
EXIT
INCH10: IBP IBUF+1 ; Now are pointing to next character
MOVE CHARX,@IBUF+1 ; test for SOS linenumbers or directory page.
SKIPE PAGEN ; still first page ?
JRST INCH11
CAME CHARX,[ASCII/COMME/]
JRST INCH11
AOS IBUF+1
MOVE CHARX,@IBUF+1
SOS IBUF+1
CAME CHARX,[ASCII/NT ⊗ /]
JRST INCH11
SOSG IBUF+2
INPUT 1,
ILDB CHARX,IBUF+1
CAIE CHARX,14
JRST .-4
AOS PAGEN
JRST INCHR1
INCH11: TRNN CHARX,1
JRST INCH12
MOVEM CHARX,LINEN
AOS IBUF+1
MOVNI CHARX,5
ADDM CHARX,IBUF+2 ; fix byte count
JRST INCHR1
LINEN: 0
INCH12: LDB CHARX,IBUF+1 ; get next char.
POPJ P,
COMMENT ⊗ SCAN is a subroutine which does all the input work
for the assembler. it returns one of 15 tokens, and
other information as needed. it also does all the
symbol table work for symbols, future references,
local symbols, and literals.
called by: SCAN
accumulators SCNVAL, SCANT, SCANTT, CHAR, CHARX, 3,
4, SYMLNK are used.
the token is returned in SCANT.
the previous token is in SCANTT.
the appropriate value for the token is in SCNVAL.
a symbol table pointer (if needed) is in SYMLNK.
the first char of the next token is in CHAR.
⊗
MSTATE: 0 ; to save STATE if literal is found
MMXWRD: 0 ; and MIXWRD, too
SCAN00: MOVE SCNVAL, ORIGIN ; default SCNVAL Is value of *
SKIPGE CHRTAB(CHAR) ; ≥0 → letter or digit?
JRST NOTLD ; something else
PUSHJ P, GETSEQ ; get sequence of letters and digits
SKIPE SEQLET ; is it a number?
JRST NOTNUM ; no → a symbol
MOVEI CHAR, 103 ; special token for number
JRST SCNEND ; all done
NOTNUM: MOVE 3, [POINT 6, SEQNAM] ; prepare pointer to sequence name
ILDB SCNVAL, 3 ; get first char
SUBI SCNVAL, 20 ; reduce to real value if digit
JUMPL SCNVAL, GETHSH ; non-digit → not a local
CAILE SCNVAL, 11
JRST GETHSH
ILDB 4, 3 ; get next char
MOVE 3, SEQNAM ; all other chars should be blank
AND 3, [77777777]
JUMPN 3, GETHSH ; non-blank → not a local
MOVE 3, LOCALN(SCNVAL) ; get local counter
CAIE 4, 42 ; is it a "B"?
JRST .+3
ADD 3, LOCALQ(SCNVAL) ; correction if this line begins with iH
SOJA 3, LOCAL ; B → decrease count to get right number
CAIN 4, 46 ; is it an "F"?
JRST LOCAL ; F → nothing special
CAIE 4, 50 ; is it an "H"?
JRST GETHSH ; no → not a local
AOS LOCALN(SCNVAL) ; H → increment for next occurrence
SETOM LOCALQ(SCNVAL) ; correction for use with iB
LOCAL: MOVEM 3, SEQNAM+1 ; fill in SEQNAM
MOVE 3, XLOCAL(SCNVAL) ; /dLOCAL/
MOVEM 3, SEQNAM ; / n/
GETHSH: HASH
MOVE 3, SEQNAM ; 3 and 4 will be used for compare
MOVE 4, SEQNAM+1
JRST NXTSYM ; first check if this bucket used yet
FNDSYM: CAME 3, (SCNVAL) 1 ; is this it?
JRST NXTSYM ; no
CAME 4, (SCNVAL) 2
JRST NXTSYM ; no
MOVE SYMLNK, SCNVAL ; save link to symbol table
SKIPL (SCNVAL) ; is it a future reference?
JRST REGLAR ; no
MOVE SCNVAL, (SCNVAL) 3 ; use chained address
MOVEI CHAR, 102 ; special token for future reference
JRST SCNEND ; all done
REGLAR: MOVE SCNVAL, (SCNVAL) 3 ; get equivalent MIX word
MOVEI CHAR, 101 ; special token for symbol
JRST SCNEND ; all done
NXTSYM: MOVE CHAR, SCNVAL ; to save if undefined
HRRZ SCNVAL, (SCNVAL) ; get next pointer
JUMPN SCNVAL, FNDSYM ; ≠0 → keep looking
MOVEM 3, ENTRY ; put in symbol name
MOVEM 4, ENTRY+1
MOVEM CHAR, ENTLNK ; ENTLNK = place to put pointer to entry
MOVNI SCNVAL, 1 ; SCNVAL ← -1
MOVEI CHAR, 102 ; special token for future reference
MOVE SYMLNK, LINK ; save LINK
JRST SCNEND ; all done
NOTLD: JUMPN CHAR, NOTSP ; is CHAR a <space>?
PUSHJ P,INCHAR ; yes → get next char
MOVE CHAR, CHARX
JRST SCAN00 ; and try again
NOTSP: CAIE CHAR, 35 ; is CHAR a "="?
JRST NOTEQ ; no
SKIPE MSTATE ; MSTATE≠0 → right end of literal
JRST SCNEND
MOVEM STATE, MSTATE ; save STATE so WVAL doesn't destroy it
MOVEM MIXWRD, MMXWRD ; and also MIXWRD
PUSHJ P,INCHAR ; next char for next SCAN
MOVE CHAR, CHARX
PUSHJ P, WVAL00-2 ; get WVAL for literal
CAIE SCANT, EQUALS ; should be an "="
PUSHJ P, [ZERROR <[ASCIZ /NO "=" AFTER LITERAL: IGNORE ALL UNTIL I FIND IT/]>,5,<[ASCIZ /5 /]>
$0: SKIPN SCANT
POPJ P,
PUSHJ P, SCAN00
CAIN SCANT, EQUALS
POPJ P,
JRST $0]
MOVE 3, [SIXBIT /=LIT=/] ; set up new variable name in SEQNAM
OR 3, BYTEWV ; use last six bits for byte descriptor
MOVEM 3, SEQNAM
MOVEM MIXWRD, SEQNAM+1
MOVE STATE, MSTATE ; restore STATE
MOVE MIXWRD, MMXWRD ; and MIXWRD
SETZM MSTATE ; and MSTATE
PUSHJ P,INCHAR ; next char for next SCAN
JRST GETHSH ; now continue with new variable
NOTEQ: CAIE CHAR, 33 ; is CHAR a ";"?
JRST NOTSEM ; no
PUSHJ P,INCHAR ; wait for an end-of-line
CAIE CHARX, 100
JRST .-2
MOVE CHAR, CHARX
JRST SCNEND ; all done
NOTSEM: CAIN CHAR, 100 ; end-of-line?
JRST SCNEND ; yes → all done
PUSHJ P,INCHAR ; get next char
CAIE CHAR, 17 ; is CHAR a "/"
JRST SCNEND ; no
CAIE CHARX, 17 ; yes → check for another "/"
JRST SCNEND ; no
PUSHJ P,INCHAR ; get next char
MOVEI CHAR, 104 ; special token for "//"
SCNEND: MOVE SCANTT, SCANT ; save old token
HRRZ SCANT, CHRTAB(CHAR) ; SCANT ← new token
MOVE CHAR, CHARX ; set up for next SCAN
CAIE SCANT, 77 ; bad token?
POPJ P, ; no, so SCAN is finished
ZERROR <[ASCIZ /ILLEGAL CHARACTER: IGNORED/]>,6,<[ASCIZ /6 /]>
JRST SCAN00
COMMENT ⊗ LOCALN and XLOCAL give the necessary data for dealing
with local symbols.
LOCALN+i gives the number of the next occurrence of
"iH".
XLOCAL+i gives the sixbit for "iLOCAL".
⊗
LOCALN: REPEAT 12 {1}
LOCALQ: BLOCK 12
XLOCAL: SIXBIT /0LOCAL/
SIXBIT /1LOCAL/
SIXBIT /2LOCAL/
SIXBIT /3LOCAL/
SIXBIT /4LOCAL/
SIXBIT /5LOCAL/
SIXBIT /6LOCAL/
SIXBIT /7LOCAL/
SIXBIT /8LOCAL/
SIXBIT /9LOCAL/
COMMENT ⊗ there are several places where a special scan is required.
SCANL --- this is the scanner which looks for
something in the LOC field. it checks the
first character to see if it is an *, and if
so goes on to the next line. if it is a
<space>, an empty LOC field is assumed.
otherwise, it transfers to the normal
scanner. when SCANL is called, a future
reference (06=UPAR) or an empty LOC field
(07=LOC) must b found, or there is some
syntax error (or else the assembler blew it).
SCANO -- this is the scanner which looks for the
symbol in the OP field. if anything except a
symbol is found, there is a syntax error (or,
once again, the assembler blew it).
SCANA -- this is the scanner which looks for the
characters after the pseudo-op ALF. SCANA
allows exactly one space (or <tab>, of
course), and then takes the next 5
characters. it also reads on to ignore all
the remaining characters in the line.
⊗
SCANL0: PUSHJ P,INCHAR ; get first character
MOVE CHAR, CHARX ; put into CHAR
CAIN CHAR, 12 ; is it an *?
JRST MUMBLE ; yes → comment card
JUMPN CHAR, SCAN00 ; 0 → empty LOC field
PUSHJ P,INCHAR ; next char for next SCAN
MOVEI CHAR, 105 ; special token for empty LOC field
JRST SCNEND ; all done
MUMBLE: PUSHJ P,INCHAR ; * → comment
CAIE CHARX, 100 ; read on until end-of-line
JRST MUMBLE
MOVE CHAR, CHARX
JRST SCNEND ; and all done with line
SCANO0: JUMPN CHAR, SCANO1 ; 0 → <space>
PUSHJ P,INCHAR ; <space> → try again
MOVE CHAR, CHARX
JRST SCANO0
SCANO1: SKIPE CHRTAB(CHAR) ; 0 → letter
JRST [cain char, ';' ; not letter → end of line?
jrst noteq+2 ; yes → OK, it's just a comment
jrst badop] ; no → error
PUSHJ P, GETSEQ ; get sequence
MOVEI CHAR, 101 ; special token for symbol
JRST SCNEND ; all done
SCANA0: SETZ MIXWRD, ; clear out MIXWRD
MOVEI 3, 5 ; get first 5 characters
MOVE 4, [POINT 6, MIXWRD, 5]; init pointer
SCANA1: PUSHJ P,INCHAR ; get char
CAIL CHARX, 100 ; was it a carriage return?
JRST SCANA2 ;*RES* yes → all done now
MOVE CHARX, SIXMIX(CHARX) ; convert to MIX-code
IDPB CHARX, 4 ; put into MIXWRD
SOJG 3, SCANA1 ; back for more
POPJ P,
PUSHJ P,INCHAR ;*RES* LOOK FOR END OF LINE
CAIE CHARX,100 ;*RES* GO UNTIL CRLF FOUND
JRST .-2 ;*RES*
SCANA2: MOVEI SCANT,0 ;*RES* TELL THE GANG WE'RE DONE
POPJ P, ;*RES*
COMMENT ⊗ GETSEQ -- a subroutine which gets the next sequence
of letters and digits from the input file. it assumes
that the first char is in CHAR and will finish with
the first char following the sequence in CHARX.
called by: PUSHJ P, GETSEQ
accumulators 3, 4, SCNVAL are used.
at return, SEQLET=0 → it was a number
-1→ it was a symbol
SCNVAL will contain the numeric value of a number and
unknown information for a symbol.
SEQNAM will contain the first 12 SIXBIT chars of the
sequence.
⊗
SEQLET: 0 ; flag indicating whether number or symbol
SEQC: =12 ; maximum of 12 chars in SEQNAM
SEQP: POINT 6, SEQNAM ; pointer to chars in SEQNAM
SEQNAM: 0 ; will hold SIXBIT chars of sequence
0
GETSEQ: SETZB SCNVAL, SEQLET ; 0 → no letters yet
MOVE 3, SEQC ; 3 is a counter
MOVE 4, SEQP ; 4 is a pointer into SEQNAM
SETZM SEQNAM ; clear SEQNAM to <space>'s
SETZM SEQNAM+1
SKIPA CHARX, CHAR ; load CHARX from CHAR
GSEQ1: SOJLE 3, .+2 ; don't deposit too many chars
IDPB CHARX, 4 ; put char into SEQNAM
SKIPN CHRTAB(CHARX) ; =0 if letter
SETOM SEQLET ; -1 → letter
IMULI SCNVAL, =10 ; find new SCNVAL
ADD SCNVAL, CHRTAB(CHARX)
SOJ SCNVAL, ; correction factor
PUSHJ P,INCHAR ; get next char
SKIPL CHRTAB(CHARX) ; <0 → not a letter or digit
JRST GSEQ1 ; letter or digit → keep going
POPJ P, ; all done so return
COMMENT ⊗ CHRTAB is the table which indicates what various
input characters are according to the following
scheme:
A-Z 0
k k+1 (k is any digit)
α 1B0 ∨ β (β is the token number for the character α)
⊗
CHRTAB: 1B0 ∨ 77 ; <space>
1B0 ∨ 77 ; ! 01
1B0 ∨ 77 ; " 02
1B0 ∨ 77 ; # 03
1B0 ∨ 77 ; $ 04
1B0 ∨ 77 ; % 05
1B0 ∨ 77 ; & 06
1B0 ∨ 77 ; ' 07
1B0 ∨ LPAREN ; ) 10
1B0 ∨ RPAREN ; ) 11
1B0 ∨ STAR ; * 12
1B0 ∨ PLUS ; + 13
1B0 ∨ COMMA ; , 14
1B0 ∨ MINUS ; - 15
1B0 ∨ 77 ; . 16
1B0 ∨ SLASH ; / 17
01 ; 0 20
02 ; 1 21
03 ; 2 22
04 ; 3 23
05 ; 4 24
06 ; 5 25
07 ; 6 26
10 ; 7 27
11 ; 8 30
12 ; 9 31
1B0 ∨ COLON ; : 32
1B0 ∨ 77 ; ; 33
1B0 ∨ 77 ; < 34
1B0 ∨ EQUALS ; = 35
1B0 ∨ 77 ; > 36
1B0 ∨ 77 ; ? 37
1B0 ∨ 77 ; @ 40
0 ; A 41
0 ; B 42
0 ; C 43
0 ; D 44
0 ; E 45
0 ; F 46
0 ; G 47
0 ; H 50
0 ; I 51
0 ; J 52
0 ; K 53
0 ; L 54
0 ; M 55
0 ; N 56
0 ; O 57
0 ; P 60
0 ; Q 61
0 ; R 62
0 ; S 63
0 ; T 64
0 ; U 65
0 ; V 66
0 ; W 67
0 ; X 70
0 ; Y 71
0 ; Z 72
1B0 ∨ 77 ; [ 73
1B0 ∨ 77 ; <back-slash> 74
1B0 ∨ 77 ; ] 75
1B0 ∨ 77 ; ↑ 76
1B0 ∨ 77 ; ← 77
1B0 ∨ LINE ; end-of-line 100
1B0 ∨ SYMBOL ; symbol 101
1B0 ∨ UPAR ; future-reference 102
1B0 ∨ NUMBER ; number 103
1B0 ∨ LEFTAR ; // 104
1B0 ∨ LOC ; empty LOC field 105
SIXMIX: =00 ; <space>
=56 ; ! 01
=56 ; " 02
=56 ; # 03
=49 ; $ 04
=56 ; % 05
=56 ; & 06
=55 ; ' 07
=42 ; ( 10
=43 ; ) 11
=46 ; * 12
=44 ; + 13
=41 ; , 14
=45 ; - 15
=40 ; . 16
=47 ; / 17
=30 ; 0 20
=31 ; 1 21
=32 ; 2 22
=33 ; 3 23
=34 ; 4 24
=35 ; 5 25
=36 ; 6 26
=37 ; 7 27
=38 ; 8 30
=39 ; 9 31
=54 ; : 32
=53 ; ; 33
=50 ; < 34
=48 ; = 35
=51 ; > 36
=56 ; ? 37
=52 ; @ 40
=01 ; A 41
=02 ; B 42
=03 ; C 43
=04 ; D 44
=05 ; E 45
=06 ; F 46
=07 ; G 47
=08 ; H 50
=09 ; I 51
=11 ; J 52
=12 ; K 53
=13 ; L 54
=14 ; M 55
=15 ; N 56
=16 ; O 57
=17 ; P 60
=18 ; Q 61
=19 ; R 62
=22 ; S 63
=23 ; T 64
=24 ; U 65
=25 ; V 66
=26 ; W 67
=27 ; X 70
=28 ; Y 71
=29 ; Z 72
=56 ; [ 73
=56 ; <back-slash> 74
=56 ; ] 75
=56 ; ↑ 76
=56 ; ← 77
OPDEF SCAN [PUSHJ P, SCAN00]
OPDEF SCANL [PUSHJ P, SCANL0]
OPDEF SCANO [PUSHJ P, SCANO0]
OPDEF SCANA [PUSHJ P, SCANA0]
COMMENT ⊗ EXPR -- this is a subroutine to find the longest
possible expression and to return it's value in
VALUE.
it assumes that the first token of the expression is
in SCANT and will finish with the first token
following the expression in SCANT.
called by: EXPR
accumulators XSTATE, BINOP, VALUE, VALUE+1, CHARX are
used.
note: this section works just like a finite-state
machine.
⊗
OPDEF EXPR [PUSHJ P, .]
MOVEI XSTATE, 2 ; begin in state 2
MOVEI BINOP, PLUS ; assume "+" to start with
SETZB VALUE, EXPSIG ; init VALUE to zero
EXPR00: IMULI XSTATE, TOKENS ; get next state
ADD XSTATE, SCANT
MOVE XSTATE, EXPR2-2*TOKENS(XSTATE)
MOVEI CHARX, 1 ; for return w/o SCAN
XCT EXPR0(XSTATE) ; semantics
SCAN ; get next token
JRST EXPR00
; state-tables for EXPR fsa
EXPR2: STATAB (1,1,1,1, 4,4,1,1, 3,5,4,1, 1,1,1)
EXPR3: STATAB (1,1,1,1, 4,4,1,1, 1,1,4,1, 1,1,1)
EXPR4: STATAB (0,0,0,0, 0,0,0,0, 3,3,3,3, 3,3,0)
EXPR5: STATAB (1,1,1,1, 4,4,1,1, 1,1,4,1, 1,1,1)
; semantic routines
EXPR0: POPJ P, ; 0 → OK and return
JRST EXPRER ; 1 → error
0 ; 2 never used after start
MOVE BINOP, SCANT ; set binary operator
PUSHJ P, EXPR04 ; evaluate expression
PUSHJ P, [MOVE BINOP, SCANT ; set binary operator
SETOM EXPSIG ; and init sign to "-"
POPJ P, ]
EXPR04: TLZE SCNVAL, 400000 ; convert to PDP-10 word
MOVNS SCNVAL
XCT BINOPR-10(BINOP) ; calculate value of expression
SETZ CHARX, ; init special sign to "+"
JUMPGE VALUE, .+2 ; test value
SETO CHARX, ; value<0 → change special sign
XCT OPRSIG-10(BINOP) ; decide whether to use special sign
MOVEM CHARX, EXPSIG ; if haven't skipped, then use it
POPJ P, ; return
BINOPR: ADD VALUE, SCNVAL ; +
SUB VALUE, SCNVAL ; -
IMUL VALUE, SCNVAL ; *
IDIV VALUE, SCNVAL ; /
PUSHJ P, BOLA ; ←
PUSHJ P, BOCOL ; :
OPRSIG: SKIPE VALUE ; +,- → don't replace sign if value is zero
SKIPE VALUE
JUMP ; otherwise → do replace it, so no-op
JUMP
JUMP
JUMP
BOLA: SETZ VALUE+1, ; clear for shift and divide
ASHC VALUE, -5 ; shift into proper position
DIV VALUE, SCNVAL ; now divide
POPJ P, ; all done with //
BOCOL: IMULI VALUE, =8 ; multiply by 8
ADD VALUE, SCNVAL ; and add next operator
POPJ P, ; all done with :
EXPRER: ZERROR <[ASCIZ /ERROR IN EXPRESSION: VALUE SET TO ZERO/]>,7,<[ASCIZ /7 /]>
SETZ VALUE,
POPJ P,
EXPSIG: 0
SAVSIG: 0
COMMENT ⊗ WVAL -- a subroutine to find the longest possible
W-value and to put the assembled W-value into MIXWRD.
it assumes that the first token of the W-value will
be the next token to be SCANed and will finish with
the first token following the W-value in SCANT.
called by: WVAL
accumulators STATE, MIXWRD, CHARX, FPART, SAVER are
used.
note: this section also works like a finite-state
machine.
⊗
OPDEF WVAL [PUSHJ P, .]
MOVEI STATE, 2 ; begin in state 2
SETZB MIXWRD, BYTEWV ; init MIXWRD to "+0", BYTEWV to (0:5)
WVAL00: SCAN ; get token
IMULI STATE, TOKENS ; get next state
ADD STATE, SCANT
MOVE STATE, WVAL2-2*TOKENS(STATE)
SETZ CHARX, ; 0 → return w/ SCAN
XCT WVAL0(STATE) ; semantics
JRST WVAL00(CHARX) ; reg 1 tells whether to SCAN or not
; state-tables for WVAL fsa.
WVAL2: STATAB (1,1,1,1, 3,3,1,1, 3,3,3,1, 1,1,1)
WVAL3: STATAB (0,2,4,0, 0,0,0,0, 0,0,0,0, 0,0,0)
WVAL4: STATAB (1,1,1,1, 5,5,1,1, 5,5,5,1, 1,1,1)
WVAL5: STATAB (1,1,1,6, 1,1,1,1, 1,1,1,1, 1,1,1)
WVAL6: STATAB (0,2,0,0, 0,0,0,0, 0,0,0,0, 0,0,0)
; semantic routines for WVAL
WVAL0: JRST WVALZZ ; 0 → OK and return
JRST WVALER ; 1 → error
PUSHJ P, PUTIN ; put into MIXWRD
PUSHJ P, WVAL03 ; save VALUE and init FPART
JUMP ; no-op
EXPR ; get field expression
MOVE FPART, VALUE ; replace FPART by newly evaluated EXPR
PUSHJ P, PUTIN ; put into MIXWRD
WVALZZ: PUSHJ P, PUTIN ; put into MIXWRD
POPJ P, ; return
WVAL03: EXPR ; get expression
MOVE SAVER, EXPSIG ; must save sign of espression
MOVEM SAVER, SAVSIG
MOVE SAVER, VALUE ; save VALUE
MOVEI FPART, 5 ; init FPART to (0:5)
POPJ P, ; return
PUTIN: TDNE FPART, [XWD 777777, 777700] ; check for out of range F-part
JRST BADF
SKIPN VALIDF(FPART) ; check table for validity
JRST BADF
FAGAIN: CAILE FPART, 5 ; FPART≤5 → use sign byte also
JRST .+4 ; don't use sign byte
SKIPE SAVSIG ; check sign of SAVER
TLOA MIXWRD, 400000 ; MIXWRD(0:0) ← "-"
TLZ MIXWRD, 400000 ; MIXWRD(0:0) ← "+"
JUMPGE SAVER, .+2 ; check sign of SAVER
MOVNS SAVER ; get absolute value
DPB SAVER, VALIDF(FPART) ; put byte into MIXWRD
HLRZ 3, BYTAB(FPART) ; fix BYTEWV
OR 3, BYTEWV ; or in beginning and ending bits
ANDCM 3, BYTAB(FPART) ; and out middle bits
MOVEM 3, BYTEWV ; and replace it
POPJ P, ; now we are all done
BADF: ZERROR <[ASCIZ /BAD F-PART: ASSUMED TO BE (0:5)/]>,10,<[ASCIZ /10 /]>
MOVEI FPART, 5
JRST FAGAIN
WVALER: ZERROR <[ASCIZ /ERROR IN W-VALUE: ASSUMED TO BE 0/]>,11,<[ASCIZ /11 /]>
SETZ MIXWRD,
POPJ P,
COMMENT ⊗ VALIDF is a table of byte pointers into MIXWRD.
if FPART contains a number from 0-64 inclusive,
then VALIDF(FPART) is 0 if FPART is invalid
or a byte pointer to the correct bytes in MIXWRD
if FPART is valid.
(sign byte not included.)
⊗
VALIDF: 44B5
ULIST1
FOR Y←1,5
{POINT Y*6, MIXWRD, Y*6+5
}
REPEAT 2, {0}
FOR X←1,5
{FOR Y←0,5
{ULIST2
IFGE Y-X, THEN
{POINT (Y-X+1)*6, MIXWRD, Y*6+5
}
IFL Y-X, THEN
{0
}
}
REPEAT 2, {0}
}
LIST
REPEAT 20, {0}
COMMENT ⊗ BYTAB is the table used to get the right bits for fixing
BYTEWV, which will be used for BYTEN when puting the
value of MIXWRD into OUTLIN. All this crap is to make
the output actually show in the byte divisions found
while getting the W-value.
⊗
BYTEWV: 0
ULIST1
BYTAB: FOR XX←0,7 {FOR YY←0,7
{ULIST2
X←←XX
Y←←YY
IFE X, {X←←1}
BYTABL←←BYTABR←←0
IFGE X-2, {IFLE X-5, {BYTABL←←BYTABL ∨ 1⊗(5-X)}}
IFGE Y-1, {IFLE Y-4, {BYTABL←←BYTABL ∨ 1⊗(4-Y)}}
FOR Z←X+1,Y
{IFGE Z-2, {IFLE Z-5, {BYTABR←←BYTABR ∨ 1⊗(5-Z)}}}
XWD BYTABL, BYTABR
}}
LIST
COMMENT ⊗ MAIN is the section which starts off each line.
it looks for a LOC, then an OP, and then transfers
control as indicated by the OP.
⊗
SAVLNK: 0 ; to save symbol table link
lfflg: 0
FIRST: 0 ; ≠0 → not doing first page
MAIN: skipn first
pushj p,hdr
PUTSTR OUTLIN ; output previous line
ERROUT ; and whatever errors it had.
MAIN99: MOVE P, [IOWD 100, PDL] ; init push-down pointer again, just in case
MOVE 3, OUTP0 ; init pointer to OUTLIN
MOVEM 3, OUTP
movei 3, =32 ; text is sent starting at columne 32
movem 3,outn
MOVE 3, [XWD OUTL0, OUTLIN] ; blank out first fields of OUTLIN
BLT 3, OUTLIN+5
MOVEI 3, =9 ; must zero out all LOCALQ's
SETZM LOCALQ(3)
SOJGE 3, .-1
SETZM ENTLNK ; 0 → already in table
SETZM FROK ; 0 → no fut-ref yet
SCANL ; special scan for LOC
JUMPE SCANT, MAIN ; end-of-line → try again
CAIN SCANT, UPAR ; is it a future-reference?
JRST ISFUT ; yes
CAIE SCANT, LOC ; no, is it an empty LOC field?
PUSHJ P, [ZERROR <[ASCIZ /INVALID LOC FIELD/]>,12,<[ASCIZ /12 /]>
POPJ P,]
SETZ SYMLNK, ; SYMLNK=0 → empty LOC field
JRST GETOP ; now get operator
ISFUT: SKIPE ENTLNK ; 0 → defined so con't add to table
ADDSYM ; add to table
MOVEM ORIGIN, (SYMLNK) 3 ; value of symbol is that of origin
JUMPGE SCNVAL, CHAIN ; SCNVAL≥0 → part of chain
HRRZS (SYMLNK) ; defined and no chain
JRST GETOP
CHAIN: ANDI SCNVAL, 7777 ; get good bits out of chained address
ORI SCNVAL, 200000 ; no longer a future reference
HRLM SCNVAL, (SYMLNK) ; put starting chain address into entry
MOVEI 3, "←" ; for a neater output
DPB 3, ARROW2
GETOP: MOVEM SYMLNK, SAVLNK ; save link to symbol table
SCANO ; get token for OP
CAIE SCANT, SYMBOL ; is it a symbol?
JRST [jumpn scant, badop ; no → is it end of line?
jrst main] ; yes → then we're all done with this line
FIND: MOVEI 6, OPLIST ; initialize lower bound
MOVEI 7, LASTOP ; initialize upper bound
FIND00: MOVE 1, 7 ; get index
ADD 1, 6
LSH 1, -1 ; divide by 2 to get average
MOVE 5, (1) ; get OP's for comparison
SUB 5, SEQNAM
JUMPG 5, LOWER ; it is lower in list
JUMPL 5, UPPER ; it is higher in list
SKIPGE MIXWRD, GOTOP-OPLIST(1) ; this is it!!
JRST (MIXWRD) ; bit 0 = 1 → pseudo-op
JRST OPCODE ; a MIX operator
LOWER: MOVNI 7, 1 ; reset upper limit
ADDB 7, 1 ; to index-1
CAML 7, 6 ; lower>upper → error
JRST FIND00
JRST BADOP
UPPER: MOVEI 6, 1 ; reset lower limit
ADDB 6, 1 ; to index+1
CAML 7, 6 ; lower>upper → error
JRST FIND00
JRST BADOP
COMMENT ⊗ note that OPCODE (MAIN) is also done by pretending
to be a finite-state machine.
⊗
OPCODE: MOVEI STATE, 2 ; begin in state 2
SETZM ENTLNK ; in case we get a future reference
SETZM FROK ; will be non-zero only if find a future-reference
MOVEI 3, 7 ; BYTEN ← standard instruction format
MOVEM 3, BYTEN
MAIN00: SCAN ; get token
IMULI STATE, TOKENS ; get next state
ADD STATE, SCANT
MOVE STATE, MAIN2-2*TOKENS(STATE)
SETZ CHARX, ; 0 → return w/ SCAN
XCT MAIN0(STATE) ; semantics
JRST MAIN00(CHARX) ; reg 1 tells whether to SCAN or not
; state-tables for MAIN fsa
MAIN2: STATAB (0,5,7,1, 3,3,4,1, 3,3,3,1, 1,1,1)
MAIN3: STATAB (0,5,7,1, 1,1,1,1, 1,1,1,1, 1,1,1)
MAIN4: STATAB (0,5,7,1, 1,1,1,1, 1,1,1,1, 1,1,1)
MAIN5: STATAB (12,12,12,12, 6,6,12,12, 6,6,6,12, 12,12,12)
MAIN6: STATAB (0,12,7,12, 12,12,12,12, 12,12,12,12, 12,12,12)
MAIN7: STATAB (13,13,13,13, 10,10,13,13, 10,10,10,13, 13,13,13)
MAIN8: STATAB (13,13,13,11, 13,13,13,13, 13,13,13,13, 13,13,13)
MAIN9: STATAB (0,13,13,13, 13,13,13,13, 13,13,13,13, 13,13,13)
; semantic routines
MAIN0: JRST ASSEMB ; 0 → assemble word
JRST MAINER ; 1 → error
0 ; 2 never used after start
PUSHJ P, MAIN03 ; put address into MIXWRD
PUSHJ P, MAIN04 ; put future reference into MIXWRD
JUMP ; no-op
PUSHJ P, MAIN06 ; put index into MIXWRD
JUMP ; no-op
EXPR ; get field expression
PUSHJ P, [SKIPGE VALUE ; test sign
MOVNS VALUE ; get absolute value
DPB VALUE, [POINT 6, MIXWRD, 29] ; put field into MIXWRD
POPJ P,]
JRST MER12 ; error for index
JRST MER13 ; error for field
MAIN03: EXPR ; get address expression
JRST M04XX
MAIN04: SETZM EXPSIG ; fix sign of VALUE
SKIPGE SCNVAL ; SCNVAL has value for future-reference
SETOM EXPSIG ; SCNVAL<0 → change value of EXPSIG
MOVE VALUE, SCNVAL
MOVEM SYMLNK, FROK ; to save link to table
MOVEI 3, "↓" ; also for a neater output
DPB 3, ARROW1
MOVE 3, [XWD ENTLNK, SAVENT] ; also must save ENTRY
BLT 3, SAVENT+2
M04XX: SKIPL EXPSIG ; test sign
JRST .+3 ; "+" → don't do anything
MOVNS VALUE ; get absolute value
TLO MIXWRD, 400000 ; MIXWRD(0:0) ← "-"
ANDI VALUE, 7777 ; get good bits
TSO MIXWRD, VALUE ; fix MIXWRD(1:2)
POPJ P, ; return
MAIN06: EXPR ; get index expression
SKIPGE VALUE ; test sign
MOVNS VALUE ; get absolute value
DPB VALUE, [POINT 6, MIXWRD, 23] ; fix MIXWRD(3:3)
POPJ P, ; return
MAINER: ZERROR <[ASCIZ /ERROR IN OR AFTER ADDRESS-FIELD/]>,13,<[ASCIZ /13 /]>
HRRZS MIXWRD
MOVEI 3, " " ; error means we reset any fut-ref stuff
DPB 3, ARROW1 ; like a "↑"
SETZM FROK ; and the indicator
JRST ASSEMB
MER12: ZERROR <[ASCIZ /ERROR IN OR AFTER INDEX-FIELD/]>,15,<[ASCIZ /15 /]>
TRZN MIXWRD, 770000
JRST ASSEMB
MER13: ZERROR <[ASCIZ /ERROR IN OR AFTER FIELD-FIELD/]>,16,<[ASCIZ /16 /]>
JRST ASSEMB
FROK: 0
↑EQU: WVAL ; get W-value
MOVE SYMLNK, SAVLNK ; get back symbol table link
SKIPE SYMLNK ; 0 → empty LOC field
MOVEM MIXWRD, (SYMLNK) 3 ; extablish equivalence
MOVE 3, BYTEWV ; get byte indicator bits
MOVEM 3, BYTEN ; to use in PUTMIX
PUTMIX ; put value of MIXWRD into OUTLIN
JRST PSEND ; now finish off pseudo-op
↑ORIG: WVAL ; get W-value
PUTLOC ; put old ORIGIN into OUTLIN
MOVE 3, BYTEWV ; get byte indicator bits
MOVEM 3, BYTEN
PUTMIX ; and output new value of ORIGIN
TLZE MIXWRD, 400000 ; convert to PDP-10 word
MOVNS MIXWRD ; "-" → negate it
MOVE ORIGIN, MIXWRD ; reset ORIGIN
JRST PSEND ; and finish off pseudo-op
PSEND: CAIN SCANT, LINE ; next token should be end-of-line
JRST MAIN ; look for next line
JRST [ZERROR <[ASCIZ /SHOULD BE END-OF-LINE: WILL TRY TO FIND IT/]>,14,<[ASCIZ /14 /]>
JRST BADLIN]
SCAN ; wait until end-of-line
CAIE SCANT, LINE
JRST .-2
JRST MAIN ; look for next line
↑CON: WVAL ; get W-value
MOVE 3, BYTEWV ; BYTEN ← full word format
MOVEM 3, BYTEN
JRST ASSEMB ; now assemble it
↑ALF: SCANA ; special scan for ALF
MOVEI 3, 17 ; BYTEN ← each byte separate format
MOVEM 3, BYTEN
JRST ASSEMB ; now assemble it
ASSEMB: BUILD ; add MIXWRD to MLD file
SKIPN SYMLNK, FROK ; test whether did a fut-ref
JRST ASSMB1 ; no
MOVE 3, [XWD SAVENT, ENTLNK] ; retrieve ENTRY
BLT 3, ENTRY+1
SKIPE ENTLNK ; should we add it to table?
ADDSYM ; yes
MOVEM ORIGIN, (SYMLNK) 3 ; and set value to value of origin
ASSMB1: AOJ ORIGIN, ; increment ORIGIN
JUMPE SCANT, MAIN ; return to MAIN after end-of-line
SCAN
JRST .-2
↑ttitle:setzm ttle
move 3,[ttle,,ttle+1] ; clear default title
blt 3,ttle+9
move 15,[point 7,ttle]
ttle1: pushj p,inchar
cain charx,100
jrst main
move charx,realch
came 15,[point 7,ttle+10]
idpb charx,15
jrst ttle1
SYMAD ←← 15
A ←← 11
BPOINT ←← 12
COUNT ←← 13
HEAD ←← 14
AD0: 0
↑END: WVAL ; get WVAL for starting address
MOVEM MIXWRD, AD0 ; save starting address
PUTLOC ; gives first address to be used by undefined symbols
MOVEI 3, 2 ; want BYTEN to show (4:5) field
MOVEM 3, BYTEN
PUTMIX
PUTSTR OUTLIN ; output last line
ERROUT
OUTSTR [ASCIZ /*****/] ; tell user we're done
movei 1,14 ; start new page for symbol table.
pushj p,putchr
aos pagen
setom stflg
setzm pagex
pushj p,hdr
PUTSTR <[ASCIZ /
SYMBOL TABLE
/]> ; heading for symbol table
MOVEI SYMAD, LINKD-4 ; start search through symbol table
END1: ADDI SYMAD, 4 ; get next entry
SKIPN (SYMAD) 1 ; 0 → no more entries
JRST END2
PUTSTR <[ASCIZ /
/]>
MOVE 3, [XWD OUTL0, OUTLIN] ; blank out beginning of OUTLIN
BLT 3, OUTLIN+5
MOVE BPOINT, [POINT 6, (SYMAD) 1] ; pointer for characters of name
MOVE 3, OUTP0 ; init pointer to OUTLIN
MOVE COUNT, (SYMAD) 1 ; get last six bits of name
ANDI COUNT, 17 ; for use as BYTEN
MOVEM COUNT, BYTEN ; in case it's a literal
MOVEI COUNT, 14 ; total of 12 characters allowed
ILDB 1, BPOINT ; get char
JUMPE 1, .+5 ; don't output any chars after first space
ADDI 1, 40 ; convert to ASCII
IDPB 1, 3 ; put into OUTLIN
SOJG COUNT, .-4 ; any more?
JRST .+4 ; skip next section
MOVEI 1, 40 ; <space>
IDPB 1, 3 ; output a space
SOJG COUNT, .-1 ; repeat until filled up
MOVEM 3, OUTP ; save pointer
MOVE HEAD, (SYMAD) ; check bits in first word of entry
JUMPGE HEAD, EQUVAL ; ≥0 → not part of a chain
MOVEI 3, "←" ; pretty output again
DPB 3, ARROW2
MOVE MIXWRD, (SYMAD) 3 ; get address for chain
ANDI MIXWRD, 7777 ; get good bits for address
ORI MIXWRD, 200000 ; defined and chain also
HRLM MIXWRD, (SYMAD) ; put into entry
SETZ MIXWRD, ; init MIXWRD to 0
HLRZ COUNT, (SYMAD) 1 ; test whether literal
CAIN COUNT, '=LI'
MOVE MIXWRD, (SYMAD) 2 ; literal → use second half of name for value
MOVEM ORIGIN, (SYMAD) 3 ; establish address for symbol
PUSHJ P, BUILD1 ; build it
AOJ ORIGIN, ; increment value of *
EQUVAL: MOVE 3, OUTP ; regain pointer
MOVEI 1, 11 ; <tab>
IDPB 1, 3
MOVE 0, (SYMAD) 3 ; will use PUTDEC to output equivalent value
PUSHJ P, PTDC0 ; special entry for special init
CHAIN1: MOVE HEAD, (SYMAD) ; get new header in case of change
TLNN HEAD, 200000 ; test chain bit
JRST END19 ; not on
MOVEI 1, 11 ; <tab>
IDPB 1, 3 ; add to OUTLIN
HLRZ 0, HEAD ; now we will output the chained address
ANDI 0, 7777 ; get good bits
MOVEI 1, "(" ; start with (
IDPB 1, 3
PUSHJ P, PTLC0 ; output address
MOVEI 1, ")" ; end with )
IDPB 1, 3
END19: SETZ 1, ; 0 to end OUTLIN
IDPB 1, 3
PUTSTR OUTLIN
JRST END1
END2: OUTBOX ; output latest box
MOVEI SYMAD, LINKD-4 ; search through symbol table again
END21: ADDI SYMAD, 4
SKIPN (SYMAD) 1 ; 0 → all done
JRST END3
MOVE 4, (SYMAD) ; check if chained
TLZN 4, 200000
JRST END21 ; not chained
HRR 4, (SYMAD) 3 ; set up word for .MLD file
SKIPGE (SYMAD) 3 ; to get sign of value
TRO 4, 400000
TLO 4, 400000
PUSHJ P, PUTWRD ; output it
JRST END21
END3: SETZ 4, ; output 0 word to .MLD file
PUSHJ P, PUTWRD
MOVE 4, AD0 ; output starting address
PUSHJ P, PUTWRD
movei symad, SYMTB ; output first section of symbol table
movei count, LINKD-SYMTB ; this many entries
end31: move 4, (symad) ; this is the pointer
skipe 4 ; if there is an address,
subi 4, LINKD-4 ; make it relative to LINKD-4
pushj p, putwrd ; output it
sosle count ; any more words left?
aoja symad, end31 ; yes
movei symad, LINKD ; output second section of symbol table
movei count, 600 ; this many entries
end32: move 4, (symad) ; get first word of entry
trne 4, 777777 ; is there an address in the right half?
subi 4, LINKD-4 ; yes → make it relative to LINKD-4
pushj p, putwrd ; output it
for x←1,3
{ move 4, (symad) x ; get rest of entry
pushj p, putwrd
}
addi symad, 4 ; ready for next entry
sosle count ; any more?
jrst end32 ; yes → get them
end99: movsi p, acsave ; restore ac's
blt p, 16
move p, [iowd 40, pdl] ; and the pdp
close 1,
close 2,
close 3,
jrst button ; return to button
↑mixal: movei p, acsave
blt p, acsave+16
move p, [iowd 40, pdl]
movei 10, linkd-symtb-1
setzm symtb(10)
sojge 10, .-1
setz origin,
skipl initf
jrst .+5
init 1,0
sixbit /DSK/
ibuf
jrst dskerr
outstr [asciz /
MIXAL 16-Jan-75
/]
PUSHJ P,RESCN ;*RES* LOOK FOR NAME ON PREV LINE
PUSHJ P,FINFI2 ;*RES* FIND FILE
JRST .+3 ;*RES*
mixal1: OUTCHR ["*"]
PUSHJ P,FINFO ; get filename
move 10, [xwd blk, iname]
blt 10, iname+3
move 10, iname
movem 10, oname
movem 10, oname2
lookup 1, iname
jrst [ outstr [asciz/File not found; try again
/]
jrst mixal1]
skipl initf
jrst .+5
init 2, 0
sixbit /DSK/
xwd obuf, 0
jrst dskerr
enter 2, oname
jrst dskerr
skipl initf
jrst .+5
init 3, 10
sixbit /DSK/
xwd obuf2, 0
jrst dskerr
enter 3, oname2
jrst dskerr
aos initf
setzm box
MIXAL2: MOVE 15,[POINT 7,TTLE] ; st up title line
movei 11,
MOVE 10,INAME
PUSHJ P,PUT6
hllz 10,iname+1
jumpe 10,.+4
MOVEI 1,"."
IDPB 1,15
PUSHJ P,PUT6
move 15,[point 7,ttl1]
movei 1,11
idpb 1,15
DATE 2,
IDIVI 2,=31
MOVEI 10,1(3)
PUSHJ P,PUTD
IDIVI 2,=12
MOVE 10,MONTH(3)
MOVEI 11,
PUSHJ P,PUT7
MOVEI 10,=64(2)
PUSHJ P,PUTD
MOVEI 1,40
IDPB 1,15
MSTIME 1,
IDIVI 1,=1000
IDIVI 1,=60
IDIVI 1,=60
MOVE 10,1
PUSHJ P,PUTD
MOVEI 1,":"
IDPB 1,15
MOVEI 1,"0"
CAIGE 2,10
IDPB 1,15
MOVE 10,2
PUSHJ P,PUTD
setzm stflg
jrst main99
stflg: 0
putd: idivi 10,=10
hrlm 11,(p)
jumpe 10,.+2
pushj p,putd
hlrz 1,(p)
iori 1,"0"
IDPB 1,15
POPJ P,
put6: move 7,[point 6,10]
ildb 1,7
jumpe 1,cpopj
addi 1,40
IDPB 1,15
jrst .-4
put7: move 7,[point 7,10]
ildb 1,7
jumpe 1,cpopj
idpb 1,15
jrst .-3
ibuf: block 3
iname: sixbit / /
0
0
0
initf: -1
dskerr: outstr [asciz /SOME DSK ERROR
/]
jrst end99
BEND MIXAL
OPLIST: SIXBIT /ADD/
SIXBIT /ALF/
SIXBIT /CHAR/
SIXBIT /CMP1/
SIXBIT /CMP2/
SIXBIT /CMP3/
SIXBIT /CMP4/
SIXBIT /CMP5/
SIXBIT /CMP6/
SIXBIT /CMPA/
SIXBIT /CMPX/
SIXBIT /CON/
SIXBIT /DEC1/
SIXBIT /DEC2/
SIXBIT /DEC3/
SIXBIT /DEC4/
SIXBIT /DEC5/
SIXBIT /DEC6/
SIXBIT /DECA/
SIXBIT /DECX/
SIXBIT /DIV/
SIXBIT /END/
SIXBIT /ENN1/
SIXBIT /ENN2/
SIXBIT /ENN3/
SIXBIT /ENN4/
SIXBIT /ENN5/
SIXBIT /ENN6/
SIXBIT /ENNA/
SIXBIT /ENNX/
SIXBIT /ENT1/
SIXBIT /ENT2/
SIXBIT /ENT3/
SIXBIT /ENT4/
SIXBIT /ENT5/
SIXBIT /ENT6/
SIXBIT /ENTA/
SIXBIT /ENTX/
SIXBIT /EQU/
SIXBIT /FADD/
SIXBIT /FCMP/
SIXBIT /FDIV/
SIXBIT /FMUL/
SIXBIT /FSUB/
SIXBIT /HLT/
SIXBIT /IN/
SIXBIT /INC1/
SIXBIT /INC2/
SIXBIT /INC3/
SIXBIT /INC4/
SIXBIT /INC5/
SIXBIT /INC6/
SIXBIT /INCA/
SIXBIT /INCX/
SIXBIT /IOC/
SIXBIT /J1E/
SIXBIT /J1N/
SIXBIT /J1NN/
SIXBIT /J1NP/
SIXBIT /J1NZ/
SIXBIT /J1O/
SIXBIT /J1P/
SIXBIT /J1Z/
SIXBIT /J2E/
SIXBIT /J2N/
SIXBIT /J2NN/
SIXBIT /J2NP/
SIXBIT /J2NZ/
SIXBIT /J2O/
SIXBIT /J2P/
SIXBIT /J2Z/
SIXBIT /J3E/
SIXBIT /J3N/
SIXBIT /J3NN/
SIXBIT /J3NP/
SIXBIT /J3NZ/
SIXBIT /J3O/
SIXBIT /J3P/
SIXBIT /J3Z/
SIXBIT /J4E/
SIXBIT /J4N/
SIXBIT /J4NN/
SIXBIT /J4NP/
SIXBIT /J4NZ/
SIXBIT /J4O/
SIXBIT /J4P/
SIXBIT /J4Z/
SIXBIT /J5E/
SIXBIT /J5N/
SIXBIT /J5NN/
SIXBIT /J5NP/
SIXBIT /J5NZ/
SIXBIT /J5O/
SIXBIT /J5P/
SIXBIT /J5Z/
SIXBIT /J6E/
SIXBIT /J6N/
SIXBIT /J6NN/
SIXBIT /J6NP/
SIXBIT /J6NZ/
SIXBIT /J6O/
SIXBIT /J6P/
SIXBIT /J6Z/
SIXBIT /JAE/
SIXBIT /JAN/
SIXBIT /JANN/
SIXBIT /JANP/
SIXBIT /JANZ/
SIXBIT /JAO/
SIXBIT /JAP/
SIXBIT /JAZ/
SIXBIT /JBUS/
SIXBIT /JE/
SIXBIT /JG/
SIXBIT /JGE/
SIXBIT /JL/
SIXBIT /JLE/
SIXBIT /JMP/
SIXBIT /JNE/
SIXBIT /JNOV/
SIXBIT /JOV/
SIXBIT /JRED/
SIXBIT /JSJ/
SIXBIT /JXE/
SIXBIT /JXN/
SIXBIT /JXNN/
SIXBIT /JXNP/
SIXBIT /JXNZ/
SIXBIT /JXO/
SIXBIT /JXP/
SIXBIT /JXZ/
SIXBIT /LD1/
SIXBIT /LD1N/
SIXBIT /LD2/
SIXBIT /LD2N/
SIXBIT /LD3/
SIXBIT /LD3N/
SIXBIT /LD4/
SIXBIT /LD4N/
SIXBIT /LD5/
SIXBIT /LD5N/
SIXBIT /LD6/
SIXBIT /LD6N/
SIXBIT /LDA/
SIXBIT /LDAN/
SIXBIT /LDX/
SIXBIT /LDXN/
SIXBIT /MOVE/
SIXBIT /MUL/
SIXBIT /NOP/
SIXBIT /NUM/
SIXBIT /ORIG/
SIXBIT /OUT/
SIXBIT /SLA/
SIXBIT /SLAX/
SIXBIT /SLB/
SIXBIT /SLC/
SIXBIT /SRA/
SIXBIT /SRAX/
SIXBIT /SRB/
SIXBIT /SRC/
SIXBIT /ST1/
SIXBIT /ST2/
SIXBIT /ST3/
SIXBIT /ST4/
SIXBIT /ST5/
SIXBIT /ST6/
SIXBIT /STA/
SIXBIT /STJ/
SIXBIT /STX/
SIXBIT /STZ/
SIXBIT /SUB/
sixbit /title/
LASTOP ←← .-1
GOTOP: 0501 ; ADD
XWD 400000, ALF
0105 ; CHAR
0571 ; CMP1
0572 ; CMP2
0573 ; CMP3
0574 ; CMP4
0575 ; CMP5
0576 ; CMP6
0570 ; CMPA
0577 ; CMPX
XWD 400000, CON
0161 ; DEC1
0162 ; DEC2
0163 ; DEC3
0164 ; DEC4
0165 ; DEC5
0166 ; DEC6
0160 ; DECA
0167 ; DECX
0504 ; DIV
XWD 400000, END
0361 ; ENN1
0362 ; ENN2
0363 ; ENN3
0364 ; ENN4
0365 ; ENN5
0366 ; ENN6
0360 ; ENNA
0367 ; ENNX
0261 ; ENT1
0262 ; ENT2
0263 ; ENT3
0264 ; ENT4
0265 ; ENT5
0266 ; ENT6
0260 ; ENTA
0267 ; ENTX
XWD 400000, EQU
0601 ; FADD
0670 ; FCMP
0604 ; FDIV
0603 ; FMUL
0602 ; FSUB
0205 ; HLT
0044 ; IN
0061 ; INC1
0062 ; INC2
0063 ; INC3
0064 ; INC4
0065 ; INC5
0066 ; INC6
0060 ; INCA
0067 ; INCX
0043 ; IOC
0651 ; J1E
0051 ; J1N
0351 ; J1NN
0551 ; J1NP
0451 ; J1NZ
0751 ; J1O
0251 ; J1P
0151 ; J1Z
0652 ; J2E
0052 ; J2N
0352 ; J2NN
0552 ; J2NP
0452 ; J2NZ
0752 ; J2O
0252 ; J2P
0152 ; J2Z
0653 ; J3E
0053 ; J3N
0353 ; J3NN
0553 ; J3NP
0453 ; J3NZ
0753 ; J3O
0253 ; J3P
0153 ; J3Z
0654 ; J4E
0054 ; J4N
0354 ; J4NN
0554 ; J4NP
0454 ; J4NZ
0754 ; J4O
0254 ; J4P
0154 ; J4Z
0655 ; J5E
0055 ; J5N
0355 ; J5NN
0555 ; J5NP
0455 ; J5NZ
0755 ; J5O
0255 ; J5P
0155 ; J5Z
0656 ; J6E
0056 ; J6N
0356 ; J6NN
0556 ; J6NP
0456 ; J6NZ
0756 ; J6O
0256 ; J6P
0156 ; J6Z
0650 ; JAE
0050 ; JAN
0350 ; JANN
0550 ; JANP
0450 ; JANZ
0750 ; JAO
0250 ; JAP
0150 ; JAZ
0042 ; JBUS
0547 ; JE
0647 ; JG
0747 ; JGE
0447 ; JL
1147 ; JLE
0047 ; JMP
1047 ; JNE
0347 ; JNOV
0247 ; JOV
0046 ; JRED
0147 ; JSJ
0657 ; JXE
0057 ; JXN
0357 ; JXNN
0557 ; JXNP
0457 ; JXNZ
0757 ; JXO
0257 ; JXP
0157 ; JXZ
0511 ; LD1
0521 ; LD1N
0512 ; LD2
0522 ; LD2N
0513 ; LD3
0523 ; LD3N
0514 ; LD4
0524 ; LD4N
0515 ; LD5
0525 ; LD5N
0516 ; LD6
0526 ; LD6N
0510 ; LDA
0520 ; LDAN
0517 ; LDX
0527 ; LDXN
0107 ; MOVE
0503 ; MUL
0000 ; NOP
0005 ; NUM
XWD 400000, ORIG
0045 ; OUT
0006 ; SLA
0206 ; SLAX
0606 ; SLB
0406 ; SLC
0106 ; SRA
0306 ; SRAX
0706 ; SRB
0506 ; SRC
0531 ; ST1
0532 ; ST2
0533 ; ST3
0534 ; ST4
0535 ; ST5
0536 ; ST6
0530 ; STA
0240 ; STJ
0537 ; STX
0541 ; STZ
0502 ; SUB
xwd 400000,ttitle
IFN MIXASM,< ;finish up the FAIL assembly if making MIXAL
pdl: block 40
button: calli 12
end mixal
>;end of IFN MIXASM